Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Think Class Libraries/CTextFile 1.1/CTextFile.p

Text File | 1994-11-30 | 11.2 KB | 355 lines | [TEXT/PJMM]

unit CTextFile;
{CTextFile v1.1 © 1992 by William Studenmund. For distribution info,}
{please see attached About file. This class impliments a TEXT file à la}
{THINK Pascal. Only String reading & writing is supported.}
interface
implementation
    uses
        TCL, TextFileIntf;

    procedure CTextFile.ITextFile;
    begin    {CTextFile.ITextFile}
        inherited IDataFile;
        BufferLen := 0;
        BufferPos := 0;
        ForceEOL := false;
        LastWroteCR := false;
        MoreInFile := false;
        HaveAccessed := false;
        LongLine := false;
        OpenForInput := false;
    end;    {CTextFile.ITextFile}

    procedure CTextFile.ReadBuffer;
        var
            wasLocked: boolean;
            thePoint: ptr;
            count: longint;
    begin    {CTextFile.ReadBuffer}
        if not OpenForInput then
            FailOSErr(OpWrErr)
        else if not MoreInFile then
            FailOSErr(EOFErr);

        wasLocked := inherited Lock(TRUE);

        thePoint := @theBuffer;
        if LengthLeft < TextBufferSize then
            count := LengthLeft
        else
            count := TextBufferSize;
        inherited ReadSome(thePoint, count);    {Inherited for speed. Remove if ReadSome might be overridden!}

        BufferLen := count;
        LengthLeft := LengthLeft - count;
        BufferPos := 0;
        HaveAccessed := true;
        if (count <> TextBufferSize) or (LengthLeft = 0) then
            MoreInFile := false;

        wasLocked := inherited Lock(wasLocked)
    end;    {CTextFile.ReadBuffer}

    function CTextFile.EOF: boolean;
{Figures out if we've gotten to the end of the file; ie. if the current pointer is at the end of the file.}
{Since write files are output only, they are always at the end. For a read file, we are at the end if we are at the end }
{of the buffer, and there are no more data to be read into the computer.}
    begin    {CTextFile.EOF}
        if not OpenForInput then
            EOF := true
        else if MoreInFile then
            EOF := false
        else
            EOF := BufferPos = BufferLen
    end;    {CTextFile.EOF}

    function CTextFile.EOL: boolean;
    begin    {CTextFile.EOL}
        if not OpenForInput then
            EOL := LastWroteCR
        else begin
                if not HaveAccessed then
                    if MoreInFile then
                        self.ReadBuffer
                    else
                        FailOSErr(EOFErr);    {Empty file}

                if BufferPos = BufferLen then
                    FailOSErr(EOFErr);        {We're at the end of the file.}

                if not ForceEOL then
                    EOL := theBuffer[BufferPos] = TextEOLChar
                else
                    EOL := true;    {if Force EOL}
            end
    end;    {CTextFile.EOL}

    function CTextFile.isLongLine: boolean;
    begin    {CTextFile.isLongLine}
        isLongLine := LongLine
    end;    {CTextFile.isLongLine}

    function CTextFile.getLengthLeft: longint;
    begin    {CTextFile.getLengthLeft}
        getLengthLeft := LengthLeft;
    end;    {CTextFile.getLengthLeft}

    function CTextFile.Peek: char;
{This function attempts to impliment the read aspect of f^ for a Pascal data file. No}
{effort was made to impliment the write aspect of f^ as write & writeln are implimented,}
{along with all the inherited data writing functions.}
    begin    {CTextFile.Peek}
        if BufferPos = BufferLen then
            FailOSErr(EOFErr)        {We're at the end of the file.}
        else if ForceEOL then
            Peek := TextSpaceChar
        else begin
                if not BufferHasData then
                    self.ReadBuffer;
                Peek := theBuffer[BufferPos]
            end    {if ForceEOL}
    end;    {CTextFile.Peek}

    procedure CTextFile.Read (var theString: string; HowMuch: integer);
{Reads in a number of bytes to a pascal string, theString. NB: theString should be locked (I think).}
{The number of bytes read depends upon HowMuch. If 0 ≤ HowMuch ≤255, then that many bytes are read.}
{If HowMuch >255 (as a signed #), then 255 bytes are read. If HowMuch<0, then as many bytes are read as there}
{are characters in the string.  The number of bytes read is returned in the length of the string. If there are more}
{characters on the line than are requested, then LongLine is set. If there are exactly the requested bytes, but the char.}
{following is a CR, LongLine is NOT set, and EOL will reply true. NB: This routine will NOT read past a CR! (nor will the}
{internal Pascal Read procedure)}
        var
            lpos, lblen, c, rqlen: integer;
    begin    {CTextFile.Read}
        if not OpenForInput then    {Reading from an output stream}
            FailOSErr(OpWrErr)
        else if not HaveAccessed then
            if MoreInFile then    {Try to load some of the file the first time before EOF checking}
                self.ReadBuffer
            else
                FailOSErr(EOFErr);    {Empty file}
        if BufferPos = BufferLen then    {EOF}
            FailOSErr(EOFErr)
        else if ForceEOL then begin    {Last read we EOLed at the end of the file. We left things in a fake sence of}
                ForceEOL := false;                    {calm. Now, with this read, we hit the end.}
                BufferPos := BufferLen;
                theString := '';
                LongLine := false
            end
        else begin    {to actually read}
                if HowMuch < 0 then
                    rqlen := ord(theString[0])    {Wanting the length of the string}
                else if HowMuch > 255 then
                    rqlen := 255    {Wanted more than can read!}
                else
                    rqlen := HowMuch;    {Exactly how much was wanted}

                lpos := BufferPos;
                lblen := BufferLen;
                LongLine := false;
                c := 0;
                while theBuffer[lpos] <> TextEOLChar do begin
                        c := c + 1;
                        if c > rqlen then begin    {Check to see if we ran out of string space}
                                c := rqlen;                    {We did}
                                LongLine := true;
                                leave    {the While loop}
                            end;
                        theString[c] := theBuffer[lpos];
                        lpos := lpos + 1;
                        if lpos = lblen then                {oops! the buffer's empty}
                            if MoreInFile then begin    {but there's more in the file}
                                    self.ReadBuffer;
                                    lpos := BufferPos;
                                    lblen := BufferLen;
                                end
                            else begin            {But the file's now empty!}
                                    ForceEOL := true;
                                    lpos := lblen - 1;        {Make it NOT look like an EOF condition!}
                                    leave    {the While loop}
                                end;    {if}
                    end;    {while got characters to read}

                BufferPos := lpos;
                theString[0] := char(c);
            end    {if open for input}
    end;    {CTextFile.Read}

{•••••     •••••}

    procedure CTextFile.ReadLn (var theString: string);
{Reads either a full line, or the first 255 characters of a line into theString. This procedure attempts to impliment}
{Pascal's ReadLn procedure, but for Mac Data files. Lines exactly 255 characters long (255 char, then CR), will be}
{read properly. Longer lines will set LongLine upon exit.}
        var
            lpos, lblen, c: integer;
            aborted: boolean;
    begin    {CTextFile.ReadLn}
        if not OpenForInput then
            FailOSErr(OpWrErr)
        else if not HaveAccessed then
            if MoreInFile then    {Try to load some of the file the first time before EOF checking}
                self.ReadBuffer
            else
                FailOSErr(EOFErr);{Empty file}
{Break the if structure here so that we can pre-read and then read from eh file}
        if BufferPos = BufferLen then
            FailOSErr(EOFErr)
        else if ForceEOL then begin    {Last read we EOLed at the end of the file. We left things in a fake sence of}
                ForceEOL := false;                    {calm. Now, with this read, we hit the end.}
                BufferPos := BufferLen;
                theString := '';
                LongLine := false
            end
        else begin    {to actually read}
                lpos := BufferPos;
                lblen := BufferLen;
                LongLine := false;
                aborted := false;
                c := 0;
                while theBuffer[lpos] <> TextEOLChar do begin
                        c := c + 1;
                        if c = 256 then begin    {Check to see if we ran out of string space}
                                c := 255;
                                LongLine := true;
                                aborted := true;
                                leave    {the While loop}
                            end;
                        theString[c] := theBuffer[lpos];
                        lpos := lpos + 1;
                        if lpos = lblen then                {oops! the buffer's empty}
                            if MoreInFile then begin    {but there's more in the file}
                                    self.ReadBuffer;
                                    lpos := BufferPos;
                                    lblen := BufferLen;
                                end
                            else begin            {But the file's now empty!}
                                    ForceEOL := true;
                                    lpos := lblen - 1;        {Make it NOT look like an EOF condition!}
                                    aborted := true;
                                    leave    {the While loop}
                                end;    {if}
                    end;    {while got characters to read}

                if not aborted then begin    {deal with the CR at the end}
                        lpos := lpos + 1;
                        if lpos = lblen then                {Well! The buffer's empty}
                            if MoreInFile then begin    {but there's more in the file}
                                    self.ReadBuffer;
                                    lpos := BufferPos;
                                    lblen := BufferLen;
                                end
                            else begin            {But the file's now empty!}
{do nothing. the last char. in the buffer was the end of}
{the last line, so leave lpos pointing to the EOF condition.}
                                end;    {if}
                    end;    {if aborted}

                BufferPos := lpos;
                theString[0] := char(c);
            end    {if open for input}
    end;    {CTextFile.ReadLn}

    procedure CTextFile.Write (var theString: string);
        var
            count: longint;
            thePoint: ptr;
    begin    {CTextFile.Write}
        if OpenForInput then
            FailOSErr(WrPermErr)
        else begin
                count := length(theString);
                thePoint := @theString[1];
                inherited writesome(thePoint, count);    {Inherited for speed. Remove if WriteSome might be overridden!}

                HaveAccessed := true;
                LastWroteCR := theString[count] = TextEOLChar;    {If the last char. of the string was an EOL char.}
            end    {if open for input}
    end;    {CTextFile.Write}

    procedure CTextFile.WriteLn (var theString: string);
        var
            count: longint;
            thePoint: ptr;
            s: string[1];
    begin    {CTextFile.WriteLn}
        if OpenForInput then
            FailOSErr(WrPermErr)
        else begin
                count := length(theString);
                thePoint := @theString[1];
                inherited writesome(thePoint, count);    {Inherited for speed. Remove if WriteSome might be overridden!}

                s := TextEOLChar;
                count := 1;
                thePoint := @s[1];
                inherited writesome(thePoint, count);    {Inherited for speed. Remove if WriteSome might be overridden!}

                HaveAccessed := true;
                LastWroteCR := true;
            end    {if open for input}
    end;    {CTextFile.WriteLn}

    procedure CTextFile.Open (permission: SignedByte);
    begin    {CTextFile.Open}
        bufferHasData := false;
        HaveAccessed := false;
        ForceEOL := false;
        BufferLen := 0;
        BufferPos := 0;

        if permission = fsCurPerm then
            permission := fsRdPerm
        else if (permission = fsRdWrPerm) or (permission = fsRdWrShPerm) then
            FailOSErr(PermErr);    {Only exclusive read or write modes supported}

        if permission = fsWrPerm then
            if not self.ExistsOnDisk then
                CreateNew(gSignature, 'TEXT');

        inherited open(permission);

        if permission = fsRdPerm then begin
                OpenForInput := true;
                theLength := GetLength;
                LengthLeft := theLength;
                if theLength > 0 then
                    MoreInFile := true
                else
                    MoreInFile := false;
            end    {begin if read permission}
        else
            OpenForInput := false;
    end;    {CTextFile.Open}

    procedure CTextFile.Reset;        {Pascal way of opening file for read-only seuential access}
    begin
        Close;    {Close the file first. OK if the file wasn't open to begin with.}
        Open(fsRdPerm)
    end;    {CTextFile.Reset}

    procedure CTextFile.Rewrite;    {Pascal way of opening an empty file for write-only access}
    begin
        Close;    {Close the file first. OK if the file wasn't open to begin with.}
        Open(fsWrPerm);
{•  SetMark(0, fsFromStart);•}
        SetLength(0);                        {Zero the file out.}
    end;    {CTextFile.Rewrite}

    procedure CTextFile.OpenForAppending;    {Custom method of opening a file to append to it.}
    begin
        Close;    {Close the file first. OK if the file wasn't open to begin with.}
        Open(fsWrPerm);
        SetMark(0, fsFromLEOF);        {Go to the end.}
    end;    {CTextFile.OpenForAppending}

    procedure CTextFile.Seek (thePlace: longint);    {Pascal way of setting "the Mark." Provided since it's in the Language def.}
    begin
        SetMark(thePlace, fsFromStart)
    end;    {CTextFile.Seek}

    function CTextFile.Filepos: longint;                        {Pascal way of getting "the Mark"'s position.}
    begin
        Filepos := GetMark
    end;    {CTextFile.Filepos}
end.